home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
new2q.src
< prev
next >
Wrap
Text File
|
1991-05-29
|
2KB
|
64 lines
%%HP:T(3)F(.);
@ by the HP 48 Design Team
@
@ NEW2Q: Version of ->Q based on J.K.Horn's Algorithm [see DEC2FRAC on this
@ disk... -jkh-], but uses exit conditions like those of ->Q.
@
@ Input:
@
@ 2: Decimal Number to be converted to a fraction
@ 1: Number of decimal places of zeros required in the error.
@
@ Output:
@
@ 1: 'Numerator/Denominator'
@
@ Example:
@
@ What's the simplest fraction which agrees with sqrt(3) to 4 decimal places?
@ 3 √ 4 NEQ2Q returns '97/56'
@ '97/56-√3' EVAL returns .00009294957
@ ^^^^ note 4 zeros.
@
@
\<< -3 CF DUP2
IF 1 > SWAP FP AND
THEN OVER XPON 1 - @ calculate the input exponent.
\<< \-> X 'IFTE(X==0,-500,XPON(X))' \>> @ define a 0-tolerant XPON.
\-> f c x expo
\<< 0 1 1 f DUP IP SWAP FP @ set recursion initial cond.s.
WHILE
OVER 5 PICK / f - ABS expo EVAL @ calculate expon. of error
x SWAP - c < @ and compare with input.
OVER AND @ if not close enough and
@ the remainder's non-zero
REPEAT
INV DUP FP SWAP IP @ then calculate next iterate.
\-> B0 B1 A0 A1 R B
\<< B1 'B*B1+B0' EVAL
A1 'B*A1+A0' EVAL
R
\>>
END
DROP SWAP DROP SWAP
DUP 4 ROLL - DUP f * 0 RND @ calc. "missing" den. and num.
\-> N D D0 N0
\<<
IF 'x-expo(ABS(f-N0/D0))<c' @ if "missing" frac. is not
THEN N D @ good enough, use original.
ELSE N0 D0
IF 'N0\=/N' @ If it is really new,
THEN 200 .2 BEEP @ then beep.
END
END
\>>
\>> @ We're done, now clean up.
IF DUP ABS 1 >
THEN # 352318d SYSEVAL
ELSE DROP
END
ELSE DROP
END
\>>